{***************************************************************
    SpyGestion  Copyright (C) 2008 Christophe KOALI <nature2gas@gmail.com>
    
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
    
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
    
    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
****************************************************************}
unit modParsingClassBase;

interface

uses Classes, sFonctionsChaines,
     LibXmlParser, LibXmlComps,
     Windows, SysUtils,

     modParsingClassBaseDivTable,
     modLanguageParsing;



const
    PRESULT_VALID = true;
    PRESULT_ECHEC = false;
    
type
    //TParsingClassType = (tpcUnknow, tpcOverview);
    TParsingDivType   = (tpdtUnknow, tpdtHeader, tpdtLeftMenu, tpdtContent);

    TParsingResultState = boolean;

    // savoir ce que c'est est inutile SAUF pour la page flotte1 nécessaire
    // pour s'assurer que c'est cette page qui a été téléchargé en dernier
    // avant de poster le choix des vaisseaux (utile lorsque c'est l'humain
    // qui prend son temps pour choisir les vaisseaux et qu'entre temps
    // le robot a peut-être téléchargé la page aperçu ou construit un batiment)
    TParsingRedirectionType = (prtUndefined, prtFlotte1);



    IParsingRedirection = class(TObject)
    protected
        FError: boolean;

        // URL de la page
        FUrlOfThisPage: string;

        FPageType: TParsingRedirectionType;

        {$IFDEF DEBUG_PARSING}
           FDebugProcParsing: TsfcProcStatus;
        {$ENDIF}

        procedure DoDebugContent(const Msg: string);

    public
        property PageType    : TParsingRedirectionType read FPageType;
        
        property URLOfThisPage: string read FUrlOfThisPage;

        // initialise l'interface
        procedure Initialisation; virtual; abstract; 

        // obtient le résultat d'analyse
        function  GetFinalState: TParsingResultState; virtual; abstract;

        // obligatoire pour répercuter l'url de base sur chaque objet
        procedure SetFullURLFromBase(const BaseLink: string); virtual;


        // indique le début et la fin (useless car Init et GetFinal sont employés...
        // La différence est que Init est utilisé dans le méthode ParseBuffer et
        // est alors obligatoirement exécutée, tandis que OnStart n'est pas obligatoirement
        // exécuté puisqu'elle s'exécute à la trouvaille de la balise DIV
        // -> Cela permet de savoir si un bloc n'a pas été rencontré, mais il
        //    vaut mieux que cela soit géré en interne à la classe de base plutot
        //    qu'un attribut dans chaque interface géré par un meme code copié/collé
        //    pour chaque interface
        // Concernant OnTerminated, il y a aucun changement vu que GetFinalState
        // était appelé dès la rencontre de la balise de fermeture
        //procedure OnStart; virtual; abstract;              // lors du DIV d'ouverture  (non transmis)
        //procedure OnTerminated; virtual; abstract;         // lors du DIV de fermeture (non transmis)

        procedure ScanOnStartTag(Sender: TObject; TagName: string; Attributes: TAttrList); virtual; abstract;
        procedure ScanOnEndTag(Sender: TObject; TagName: string); virtual; abstract;
        procedure ScanOnContent(Sender: TObject; Content: string); virtual; abstract;

        {$IFDEF DEBUG_PARSING}
           property DebugProc: TsfcProcStatus read FDebugProcParsing write FDebugProcParsing;
        {$ENDIF}

        constructor Create;

    end;


    TParsingBase = class(TObject)
    private
        FScanner       : TEasyXmlScanner;
        FScannerCreated: boolean;

        FURLOfThisPage: string;
        FError        : boolean;

        //FTypeClass    : TParsingClassType;

        // Protective Critical Section object
        FReadWriteCS: TRTLCriticalSection;


        {$IFDEF DEBUG_PARSING}
           // informations de débogage
           FDebugProc: TsfcProcStatus;
        {$ENDIF}

        // Pour compter le nombre de div et savoir ainsi quand un DIV se termine
        FDivCount: integer;

        // type du div
        FDivType : TParsingDivType;

        // interface en cours (header/menu left/contenu)
        FCurrentInterface: IParsingRedirection;


        // Ogame ne respecte pas les standards et on se retrouve avec une
        // balise DIV fermante en plein milieu des rapports d'espionnage
        // ce qui fait bien sur tout foirer...
        // Son utilisation s'active avec le champ AdvDivTableGestion
        FDivTableAdv: TDivTableGestion;
        

        // verification supplémentaire
        FExistHTML: boolean;
        FExistBODY: boolean;

        FExistMenuLeft: boolean;
        FExistHeader  : boolean;
        FExistContent : boolean;
        

    protected
        procedure ScanOnStartTag(Sender: TObject; TagName: string; Attributes: TAttrList); virtual; 
        procedure ScanOnEndTag(Sender: TObject; TagName: string);  virtual;
        procedure ScanOnContent(Sender: TObject; Content: string); virtual;



        // Debogage
        procedure SetDebugProc(Value: TsfcProcStatus); virtual;
        procedure DoDebug(const Msg: string);

        // dans le sens que html, body et les deux div principales existent
        // dans le but d'identifier les erreurs de téléchargement
        function GetIsValidPage: boolean;
    public
        IHeader  : IParsingRedirection;
        IMenuLeft: IParsingRedirection;
        IContent : IParsingRedirection;

        // Les balises div et table ne respectent pas les standards du web
        // c'est à dire une structure arborescente, avec ogame on rencontre
        // parfois des balises de fermeture superflou voir même en double dont
        // la première occurence au mauvais endroit
        // Cette option permet d'activé un controle rigoureux des balises et
        // simuler la structure arborescente
        AdvDivTableGestion: boolean;

        // virtual car les classes descendent auront besoin de la surchargé
        // pour définir les liens complets des URL trouvé dans la page web
        procedure SetURLOfThisPage(Valeur: string); virtual;

        property IsValidPage: boolean read GetIsValidPage;
        
        {$IFDEF DEBUG_PARSING}
           property DebugProc: TsfcProcStatus read FDebugProc write SetDebugProc;
        {$ENDIF}

        //property ClassTypeParsing: TParsingClassType      read FTypeClass;
        property URLOfThisPage: string          read FURLOfThisPage write SetURLOfThisPage;

        property Scanneur     : TEasyXmlScanner read FScanner;
        property GetError     : boolean         read FError;

        // Parseur présent obligatoirement dans chaque page web
        // True = parsing ok
        function ParseBuffer(const Tampon: string): boolean; virtual;

        procedure Lock;
        procedure Unlock;

        constructor Create(Scanner: TEasyXmlScanner); 
        destructor Destroy; override; 
    end;


implementation

constructor IParsingRedirection.Create;
begin
    inherited;

    FPageType := prtUndefined;
end;


procedure IParsingRedirection.SetFullURLFromBase(const BaseLink: string);
begin
    
    FUrlOfThisPage := BaseLink;
end;

procedure IParsingRedirection.DoDebugContent(const Msg: string);
begin
        {$IFDEF DEBUG_PARSING}
           if Assigned(FDebugProcParsing) then begin
              FDebugProcParsing(Msg);
           end;
        {$ENDIF}
end;

(*
 <div id='header_top'>
    <select size="1" onchange="haha(this)">

 <div id='leftmenu'>
    <div id='menu'>

 <div id='content'>
*)
procedure TParsingBase.ScanOnStartTag(Sender: TObject; TagName: string; Attributes: TAttrList);
var id: string;
begin
   if Assigned(FCurrentInterface) then begin
       FCurrentInterface.ScanOnStartTag(Sender, TagName, Attributes);
   end;


   if SameText(TagName, 'html') then begin
      FExistHTML := true;

   end else if SameText(TagName, 'body') then begin
      FExistBODY := true;

   end else if SameText(TagName, 'table') then begin
      if AdvDivTableGestion then begin
         FDivTableAdv.OnTableOpen;
      end;
      
   end else if SameText(TagName, 'div') then begin

          if AdvDivTableGestion then begin
             FDivTableAdv.OnDivOpen;
          end;

          id := Attributes.Value('id');

          if FDivType <> tpdtUnknow then begin
             Inc(FDivCount);
          end;



          if SameText(id, 'header_top') then begin
             FDivType := tpdtHeader;
             FDivCount:= 1;
             FCurrentInterface    := IHeader;
             FExistHeader := true;

             {$IFDEF DEBUG_PARSING_DIV}
                DoDebug('Div open: header_top');
             {$ENDIF}



          end else if SameText(id, 'leftmenu') then begin
             FDivType := tpdtLeftMenu;
             FDivCount := 1;
             FCurrentInterface    := IMenuLeft;
             FExistMenuLeft := true;

             {$IFDEF DEBUG_PARSING_DIV}
                DoDebug('Div open: leftmenu');
             {$ENDIF}

          end else if SameText(id, 'content') then begin
             FDivType := tpdtContent;
             FDivCount := 1;
             FCurrentInterface    := IContent;
             FExistContent := true;


             {$IFDEF DEBUG_PARSING_DIV}
                DoDebug('Div open: content');
             {$ENDIF}
          end;

          if Assigned(FCurrentInterface) then begin
             //FCurrentInterface.OnStart;
          end;


   end;

end;

procedure TParsingBase.ScanOnEndTag(Sender: TObject; TagName: string);
var NbDivClosed, i: integer;
begin

    if SameText(TagName, 'div') then begin

       if AdvDivTableGestion then begin
          if FDivTableAdv.OnDivEnd then begin
             // vrai div de fermeture

          end else begin
             // faux div de fermeture
             {$IFDEF DEBUG_PARSING_DIV}
                DoDebug('Warning: Div de fermeture au mauvais endroit');
             {$ENDIF}

             // on l'ignore, donc on quitte
             exit;
          end;
       end;


       if FDivType <> tpdtUnknow then begin
          Dec(FDivCount);

          if FDivCount = 0 then begin
             FDivType := tpdtUnknow;

             if FCurrentInterface <> nil then begin
                // signal la reception de la balise de fermeture
                //FCurrentInterface.OnTerminated;

                if FCurrentInterface.GetFinalState = PRESULT_ECHEC then begin
                   // erreur
                   DoDebug('Echec: GetFinalState echec');
                   FScanner.StopParser := true;
                   FError := true;
                   exit;
                end;

             end;

             // empeche la transmission du div de fermeture à l'interface
             FCurrentInterface := nil;
          end;
       end;

    end else if SameText(TagName, 'table') then begin

       if AdvDivTableGestion then begin
          NbDivClosed := FDivTableAdv.OnTableEnd;
          if NbDivClosed > 0 then begin
             // ce table de fermeture met fin à des div
             {$IFDEF DEBUG_PARSING_DIV}
                DoDebug('Warning: Div de fermeture oublié: ' + IntToStr(NbDivClosed));
             {$ENDIF}

             // on va simuler la fermeture en appellant la fonction actuelle
             // (en simulant donc la rencontre du tag /div)
             // cependant, le gestionnaire FDivTableAdv a déjà traité l'information
             // en fermant de lui-même les balises div non fermé, DONC il ne
             // faut PAS qu'il les ferme à nouveau lors de la simulation
             FDivTableAdv.SkipVerification := true;

             for i := 1 to NbDivClosed do begin
                {$IFDEF DEBUG_PARSING_DIV}
                   DoDebug(format('Warning: Simulation fermeture %d', [i]));
                {$ENDIF}

                ScanOnEndTag(Sender, 'div');

             end;

             // Réinitialise le flag
             FDivTableAdv.SkipVerification := false;


          end;
       end;


    end;

    if Assigned(FCurrentInterface) then begin
       FCurrentInterface.ScanOnEndTag(Sender, TagName);
    end;

end;

procedure TParsingBase.ScanOnContent(Sender: TObject; Content: string);
begin
       if Assigned(FCurrentInterface) then begin
          FCurrentInterface.ScanOnContent(Sender, Content);
       end;
       
end;


function TParsingBase.ParseBuffer(const Tampon: string): boolean;
var xTampon: string;
begin


    xTampon := sfcRemplace(Tampon, 'selected', 'selected="1"');
    xTampon := sfcRemplace(xTampon, ' />', '>');
    xTampon := sfcRemplace(xTampon, '"/>', '">');

    xTampon := sfcRemplace(xTampon, '/>', '>');

    xTampon := sfcRemplace(xTampon, 'this.T_WIDTH=150;return escape("', '');
    xTampon := sfcRemplace(xTampon, '&lt;br&gt;")', '');
    xTampon := sfcRemplace(xTampon, '&lt;br&gt;', '; ');

    

    // Redéfinit les pointeurs, car il se peut que le même parseur
    // soit utilisé pour toute les pages
    Scanneur.OnEndTag   := ScanOnEndTag;
    Scanneur.OnEmptyTag := nil;
    Scanneur.OnStartTag := ScanOnStartTag;
    Scanneur.OnContent  := ScanOnContent;

    FError := false;

    FDivCount         := 0;
    FDivType          :=  tpdtUnknow;
    FCurrentInterface := nil;

    FExistHTML := false;
    FExistBODY := false;

        FExistMenuLeft:= false;
        FExistHeader  := false;
        FExistContent := false;



    if Assigned(IHeader) then begin
       IHeader.Initialisation;
    end;
    if Assigned(IMenuLeft) then begin
       IMenuLeft.Initialisation;
    end;
    if Assigned(IContent) then begin
       IContent.Initialisation;
    end;

    FDivTableAdv.Init;


    // charge le tampon
    FScanner.LoadFromBuffer(PChar(xTampon));


    //try
       FScanner.Execute;
    //except
    //   FError := true;
    //end;

    if FExistHTML = false then begin
       FError := true;
       DoDebug('Erreur xy1');
    end;
    if FExistBODY = false then begin
       FError := true;
       DoDebug('Erreur xy2');
    end;

    // L'header est quand à elle optionnelle
    if FExistMenuLeft = false then begin
       // le menu left est présent partout à présent
       DoDebug('Pas de menu à gauche trouvé');
       FError := true;
    end;
    if FExistContent = false then begin
       // le content également
       DoDebug('Pas de contenu trouvé');
       FError := true;
    end;

    Result := NoT(FError);
end;

function TParsingBase.GetIsValidPage: boolean;
begin
    Result := false;

    // L'header est quand à elle optionnelle
    if FExistMenuLeft = false then begin
       // le menu left est présent partout à présent
       exit;
    end;
    if FExistContent = false then begin
       // le content également
       exit;
    end;

    if FExistHTML = false then begin
       exit;
    end;
    if FExistBODY = false then begin
       exit;
    end;

    Result := true;
end;




procedure TParsingBase.SetDebugProc(Value: TsfcProcStatus);
begin

    {$IFDEF DEBUG_PARSING}
       FDebugProc := Value;

       // on définit la procédure de la classe actuelle pour qu'un préfixe
       // soit ajouté aux messages de débogage des classes utilisées
       if Assigned(IHeader) then begin
          IHeader.DebugProc   := DoDebug;
       end;
       if Assigned(IMenuLeft) then begin
          IMenuLeft.DebugProc := DoDebug;
       end;
       if Assigned(IContent) then begin
          IContent.DebugProc  := DoDebug;
       end;

       FDivTableAdv.DebugProc := DoDebug;
    {$ENDIF}
end;

procedure TParsingBase.DoDebug(const Msg: string);
begin
    {$IFDEF DEBUG_PARSING}
       if Assigned(FDebugProc) then begin
          FDebugProc('Parsing - ' + Msg);
       end;
    {$ENDIF}
end;

procedure TParsingBase.SetURLOfThisPage(Valeur: string);
begin
    FURLOfThisPage := Valeur;

    IHeader.SetFullURLFromBase(Valeur);
    IMenuLeft.SetFullURLFromBase(Valeur);
    IContent.SetFullURLFromBase(Valeur);
end;



procedure TParsingBase.Lock;
begin
    EnterCriticalSection(FReadWriteCS);
end;

procedure TParsingBase.Unlock;
begin
    LeaveCriticalSection(FReadWriteCS);
end;


constructor TParsingBase.Create(Scanner: TEasyXmlScanner);
begin
    inherited Create;

    InitializeCriticalSection(FReadWriteCS);
    
    FScanner := Scanner;

    if FScanner = nil then begin
       FScanner := TEasyXmlScanner.Create(nil);
       FScannerCreated := true;

    end else
       FScannerCreated := false;

    Scanneur.OnEndTag   := ScanOnEndTag;
    Scanneur.OnEmptyTag := nil;
    Scanneur.OnStartTag := ScanOnStartTag;
    Scanneur.OnContent  := ScanOnContent;


    //FTypeClass := tpcUnknow;

        IHeader  := nil;
        IMenuLeft:= nil;
        IContent := nil;


    FDivTableAdv := TDivTableGestion.Create;
    AdvDivTableGestion := false;

end;


destructor TParsingBase.Destroy;
begin

    if FScannerCreated then begin
       FScanner.Free;
    end;

    FDivTableAdv.Free;

    DeleteCriticalSection(FReadWriteCS);

    inherited Destroy;
end;


end.
